home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 March / Chip_2002-03_cd1.bin / zkuste / delphi / kolekce / d3456 / gmprintsuite_eval.exe / {app} / GmOrientationImage.pas < prev    next >
Pascal/Delphi Source File  |  2002-01-02  |  9KB  |  296 lines
  1. {******************************************************************************}
  2. {                                                                              }
  3. {                         TGmOrientationImage 2.3                             }
  4. {                                                                              }
  5. {           Copyright (c) 2001 Graham Murt  - www.MurtSoft.com                 }
  6. {                                                                              }
  7. {   Feel free to e-mail me with any comments, suggestions, bugs or help at:    }
  8. {                                                                              }
  9. {                           graham@murtsoft.com                                }
  10. {                                                                              }
  11. {******************************************************************************}
  12.  
  13. unit GmOrientationImage;
  14.  
  15. interface
  16.  
  17. uses
  18.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, GmTypes,
  19.   GmPreview, Buttons, GmConst;
  20.  
  21. type
  22.   TGmOrientationPage = class(TGmCustomPage)
  23.   private
  24.     FOrientation: TGmOrientation;
  25.     FShowHeaderFooter: Boolean;
  26.     procedure SetOrientation(AOrientation: TGmOrientation);
  27.     procedure DrawHeaderFooter(Canvas: TCanvas; AArea: TRect; Border: integer);
  28.   protected
  29.     procedure Paint; override;
  30.   public
  31.     property Orientation: TGmOrientation read FOrientation write SetOrientation;
  32.   end;
  33.  
  34.   TGmOrientationImage = class(TWinControl)
  35.   private
  36.     FBtnPortrait: TSpeedButton;
  37.     FBtnLandscape: TSpeedButton;
  38.     FOrientation: TGmOrientation;
  39.     FPreview: TGmPreview;
  40.     FPageImage: TGmOrientationPage;
  41.     FShowButtons: Boolean;
  42.     FShowHeaderFooter: Boolean;
  43.     // events...
  44.     FOnClickPortrait: TNotifyEvent;
  45.     FOnClickLandscape: TNotifyEvent;
  46.     procedure BtnClick(Sender: TObject);
  47.     procedure SetGmPreview(APreview: TGmPreview);
  48.     procedure SetOrientation(AOrientation: TGmOrientation);
  49.     procedure SetShadow(AShadow: TGmShadow);
  50.     procedure SetShowButtons(AValue: Boolean);
  51.     procedure SetShowHeaderFooter(AValue: Boolean);
  52.     function GetShadow: TGmShadow;
  53.  
  54.     { Private declarations }
  55.   protected
  56.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  57.     // update messages...
  58.     procedure OrientationChanged(var Message: TMessage); message GM_ORIENTATION_CHANGED;
  59.     procedure ComponentResize(var Message: TMessage); message WM_SIZE;
  60.     { Protected declarations }
  61.   public
  62.     constructor Create(AOwner: TComponent); override;
  63.     destructor Destroy; override;
  64.     { Public declarations }
  65.   published
  66.     property Orientation: TGmOrientation read FOrientation write SetOrientation;
  67.     property Preview: TGmPreview read FPreview write SetGmPreview;
  68.     property ShowHint;
  69.     property Shadow: TGmShadow read GetShadow write SetShadow;
  70.     property ShowButtons: Boolean read FShowButtons write SetShowButtons default True;
  71.     property ShowHeaderFooter: Boolean read FShowHeaderFooter write SetShowHeaderFooter default True;
  72.     property Visible;
  73.     property Color;
  74.     // events
  75.     property OnClickPortrait: TNotifyEvent read FOnClickPortrait write FOnClickPortrait;
  76.     property OnClickLandscape: TNotifyEvent read FOnClickLandscape write FOnClickLandscape;
  77.     { Published declarations }
  78.   end;
  79.  
  80. //procedure Register;
  81.  
  82. implementation
  83.  
  84. {$R OrienRes.RES}
  85.  
  86. //------------------------------------------------------------------------------
  87.  
  88. procedure TGmOrientationPage.SetOrientation(AOrientation: TGmOrientation);
  89. var
  90.   TempVal: integer;
  91. begin
  92.   if FOrientation <> AOrientation then
  93.   begin
  94.     FOrientation := AOrientation;
  95.     // resize page...
  96.     TempVal := Width;
  97.     Width := Height;
  98.     Height := TempVal;
  99.     Top := (TWinControl(Owner).Height - Height) div 2;
  100.     Invalidate;
  101.   end;
  102. end;
  103.  
  104. procedure TGmOrientationPage.DrawHeaderFooter(Canvas: TCanvas; AArea: TRect; Border: integer);
  105. begin
  106.   if FShowHeaderFooter then
  107.   begin
  108.     Canvas.Pen.Color := $00777777;
  109.     Canvas.Polyline([Point(AArea.Left+Border, AArea.Top+Border)   , Point(AArea.Right-Border, AArea.Top+Border)]);
  110.     Canvas.Polyline([Point(AArea.Left+Border, AArea.Bottom-Border), Point(AArea.Right-Border, AArea.Bottom-Border)]);
  111.   end;
  112. end;
  113.  
  114. procedure TGmOrientationPage.Paint;
  115. var
  116.   AChar: Char;
  117.   TextPos: TPoint;
  118.   PageArea: TRect;
  119. begin
  120.   inherited;
  121.   with Canvas do
  122.   begin
  123.     Pen.Style := psSolid;
  124.     PageArea := Rect(0,0,((Width-Shadow.Width)), ((Height-Shadow.Width)-2));
  125.     DrawHeaderFooter(Canvas, PageArea, 6);
  126.     Font.Name := 'Times New Roman';
  127.     Font.Size := 16;
  128.     Font.Color := clSilver;
  129.     Brush.Style := bsClear;
  130.     if FOrientation = gmPortrait then AChar := 'P' else AChar := 'L';
  131.     TextPos.x := (Width - TextWidth(AChar)) div 2;
  132.     TextPos.y := (Height - TextHeight(AChar)) div 2;
  133.     TextOut(TextPos.x, TextPos.y ,AChar);
  134.   end;
  135. end;
  136.  
  137. //------------------------------------------------------------------------------
  138.  
  139.  
  140. constructor TGmOrientationImage.Create(AOwner: TComponent);
  141. begin
  142.   inherited Create(AOwner);
  143.   Width := 105;
  144.   Height := 65;
  145.   FPageImage := TGmOrientationPage.Create(Self);
  146.   FPageImage.FShowHeaderFooter := True;
  147.   FShowHeaderFooter := True;
  148.   with FPageImage do
  149.   begin
  150.     Left := 40;
  151.     Width := 45;
  152.     Height := 60;
  153.     Shadow.Width := 2;
  154.     Parent := Self;
  155.   end;
  156.   FShowButtons := False;
  157.   Orientation := gmPortrait;
  158.   SetShowButtons(True);
  159. end;
  160.  
  161. destructor TGmOrientationImage.Destroy;
  162. begin
  163.   if Assigned(FPreview) then FPreview.RemoveAssociatedComponent(Self);
  164.   if Assigned(FBtnPortrait) then FBtnPortrait.Free;
  165.   if Assigned(FBtnLandscape) then FBtnLandscape.Free;
  166.   FPageImage.Free;
  167.   inherited Destroy;
  168. end;
  169.  
  170. procedure TGmOrientationImage.Notification(AComponent: TComponent; Operation: TOperation);
  171. begin
  172.   inherited Notification(AComponent, Operation);
  173.   if (Operation = opRemove) and (AComponent = FPreview) then
  174.     FPreview := nil;
  175. end;
  176.  
  177. procedure TGmOrientationImage.OrientationChanged(var Message: TMessage);
  178. begin
  179.   if Orientation <> FPreview.Orientation then
  180.     Orientation := FPreview.Orientation;
  181. end;
  182.  
  183. procedure TGmOrientationImage.ComponentResize(var Message: TMessage);
  184. begin
  185.   Width := 105;
  186.   Height := 65;
  187. end;
  188.  
  189. procedure TGmOrientationImage.BtnClick(Sender: TObject);
  190. begin
  191.   if (Sender = FBtnPortrait) and (Orientation <> gmPortrait) then
  192.   begin
  193.     Orientation := gmPortrait;
  194.     if Assigned(FOnClickPortrait) then FOnClickPortrait(Self);
  195.   end
  196.   else
  197.   if (Sender = FBtnLandscape) and  (Orientation <> gmLandscape) then
  198.   begin
  199.     Orientation := gmLandscape;
  200.     if Assigned(FOnClickLandscape) then FOnClickLandscape(Self);
  201.   end;
  202. end;
  203.  
  204. procedure TGmOrientationImage.SetGmPreview(APreview: TGmPreview);
  205. begin
  206.   if Assigned(APreview) then
  207.   begin
  208.     FPreview := APreview;
  209.     FPreview.AddAssociatedComponent(Self);
  210.     //SendMessage(FPreview.Handle, GM_REGISTER_COMPONENT, Handle, 0);
  211.     Orientation := FPreview.Orientation;
  212.   end
  213.   else
  214.     FPreview := nil;
  215. end;
  216.  
  217. procedure TGmOrientationImage.SetOrientation(AOrientation: TGmOrientation);
  218. begin
  219.   FOrientation := AOrientation;
  220.   FPageImage.Orientation := AOrientation;
  221.   // select the correct button...
  222.   if FShowButtons then
  223.   begin
  224.     FBtnPortrait.Down := AOrientation = gmPortrait;
  225.     FBtnLandscape.Down := AOrientation = gmLandscape;
  226.   end;  
  227.   if Assigned(FPreview) then FPreview.Orientation := AOrientation;
  228.   Invalidate;
  229. end;
  230.  
  231. procedure TGmOrientationImage.SetShadow(AShadow: TGmShadow);
  232. begin
  233.   FPageImage.Shadow := AShadow;
  234.   FPageImage.Invalidate;
  235. end;
  236.  
  237. procedure TGmOrientationImage.SetShowButtons(AValue: Boolean);
  238. begin
  239.   if FShowButtons <> AValue then
  240.   begin
  241.     if AValue = True then
  242.     begin
  243.       FPageImage.Left := 40;
  244.       FBtnPortrait := TSpeedButton.Create(Self);
  245.       with FBtnPortrait do
  246.       begin
  247.         Top := 6;
  248.         Left := 8;
  249.         Glyph.LoadFromResourceName(HInstance, 'BTNPORT');
  250.         GroupIndex := 1;
  251.         Down := True;
  252.         OnClick := BtnClick;
  253.       end;
  254.       FBtnLandscape := TSpeedButton.Create(Self);
  255.       with FBtnLandscape do
  256.       begin
  257.         Top := 34;
  258.         Left := 8;
  259.         Glyph.LoadFromResourceName(HInstance, 'BTNLAND');
  260.         GroupIndex := 1;
  261.         OnClick := BtnClick;
  262.       end;
  263.       FBtnPortrait.Parent := Self;
  264.       FBtnLandscape.Parent := Self;
  265.     end
  266.     else
  267.     begin
  268.       FPageImage.Left := 4;
  269.       FBtnPortrait.Free;
  270.       FBtnLandscape.Free;
  271.       FBtnPortrait := nil;
  272.       FBtnLandscape := nil;
  273.     end;
  274.     FShowButtons := AValue;
  275.   end;
  276. end;
  277.  
  278. procedure TGmOrientationImage.SetShowHeaderFooter(AValue: Boolean);
  279. begin
  280.   FShowHeaderFooter := AValue;
  281.   FPageImage.FShowHeaderFooter := AValue;
  282.   FPageImage.Repaint;
  283. end;
  284.  
  285. function TGmOrientationImage.GetShadow: TGmShadow;
  286. begin
  287.   Result := FPageImage.Shadow;
  288. end;
  289.  
  290. {procedure Register;
  291. begin
  292.   RegisterComponents('GmPrintSuite', [TGmOrientationImage]);
  293. end; }
  294.  
  295. end.
  296.